{*****************************************************************************
 *
 *  BASE64Sup.pas - BASE 64 support  (19-July-1998)
 *
 *  Copyright (c) 1998-99 Michael Haller
 *
 *  Author:     Michael Haller
 *  E-mail:     michael@discountdrive.com
 *  Homepage:   http://www.discountdrive.com/sunrise/
 *
 *  This program is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation;
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 *
 *----------------------------------------------------------------------------
 *
 *  Revision history:
 *
 *     DATE     REV                 DESCRIPTION
 *  ----------- --- ----------------------------------------------------------
 *  20/03/2003  MDH Fixed a Base64 decode bug where one or two null characters
 *                  were added at the end of the decoded text.
 *  19/10/2004  MDH Improved the performance of the base64 methods. Now the
 *                  StringToBase64 and Base64ToString methods are at least
 *                  six times faster.
 *****************************************************************************}

unit BASE64Sup;

interface

procedure PrepareBase64Support;
function StringToBase64(const S: string): string;
function Base64ToString(const S: string): string;

implementation

var
  Bit6ToBase64: array[0..63] of Byte;
  Base64ToBit6: array[0..255] of SmallInt;
  iEncodeInput: Integer;
  EncodeShifter: LongInt;
  iDecodeInput: Integer;
  DecodeShifter: LongInt;

procedure Init;
begin
  iEncodeInput := 0;
  EncodeShifter := 0;
  iDecodeInput := 0;
  DecodeShifter := 0;
end;

function AddByteToEncode(B: Byte): Boolean;
begin
  Result := True;
  if iEncodeInput = 3 then Exit;
  EncodeShifter := EncodeShifter shl 8;
  EncodeShifter := EncodeShifter or B;
  Inc(iEncodeInput);
  Result := (iEncodeInput = 3);
end;

procedure GetBase64String(var Buffer: string; var Position: Integer);
var
  I: Integer;
begin
  if iEncodeInput > 0 then begin
    EncodeShifter := EncodeShifter shl ((3 - iEncodeInput) * 8);
    for I := 4 downto 1 do begin
      Buffer[Position + I] := Chr(Bit6ToBase64[EncodeShifter and $3F]);
      EncodeShifter := EncodeShifter shr 6;
    end;

    for I := iEncodeInput + 2 to 4 do Buffer[Position + I] := '=';
    EncodeShifter := 0;
    iEncodeInput := 0;
    Position := Position + 4;
  end;
end;

function AddBase64ToDecode(B: Byte): Boolean;
begin
  Result := True;
  if iDecodeInput = 4 then Exit;
  B := Base64ToBit6[B];
  // Ignore characters outside the base64 characterset
  if B > $40 then begin Result := False; Exit; end;
  // Result true if reached a '=' character marking the end of the text
  if B = $40 then begin Exit; end;
  DecodeShifter := DecodeShifter shl 6;
  DecodeShifter := DecodeShifter or B;
  Inc(iDecodeInput);
  Result := (iDecodeInput = 4);
end;

procedure GetByteString(var Buffer: string; var Position: Integer);
var
  I: Integer;
  Count: Integer;
begin
  if iDecodeInput > 1 then begin
    Count := 3 - (4 - iDecodeInput);
    if iDecodeInput = 2 then DecodeShifter := DecodeShifter shr 4
    else if iDecodeInput = 3 then DecodeShifter := DecodeShifter shr 2;
    for I := Count downto 1 do begin
      Buffer[Position + I] := Chr(DecodeShifter and $FF);
      DecodeShifter := DecodeShifter shr 8;
    end;
    DecodeShifter := 0;
    iDecodeInput := 0;
    Position := Position + Count;
  end;
end;

procedure PrepareBase64Support;
var
  I: SmallInt;
begin
  for I := 0 to 25 do Bit6ToBase64[I] := Ord('A') + I;
  for I := 0 to 25 do Bit6ToBase64[26 + I] := Ord('a') + I;
  for I := 0 to 9 do Bit6ToBase64[52 + I] := Ord('0') + I;
  Bit6ToBase64[62] := Ord('+');
  Bit6ToBase64[63] := Ord('/');
  for I := 0 to 255 do Base64ToBit6[I] := 255;
  for I := 0 to 63 do Base64ToBit6[Bit6ToBase64[I]] := I;
  Base64ToBit6[Ord('=')] := $40;
  Init;
end;

function StringToBase64(const S: string): string;
var
  L: Integer;
  I: Integer;
  iOut: Integer;
begin
  Init;
  L := Length(S);
  iOut := 0;
  SetLength(Result, L * 2);
  for I := 1 to L do
    if AddByteToEncode(Ord(S[I])) then
      GetBase64String(Result, iOut);
  GetBase64String(Result, iOut);
  SetLength(Result, iOut);
end;

function Base64ToString(const S: string): string;
var
  L: Integer;
  I: Integer;
  iOut: Integer;
begin
  Init;
  L := Length(S);
  iOut := 0;
  SetLength(Result, L);
  for I := 1 to L do begin
    if AddBase64ToDecode(Ord(S[I])) then begin
      GetByteString(Result, iOut);
    end;
  end;
  GetByteString(Result, iOut);
  SetLength(Result, iOut);
end;

end.

